perm filename ORDER.NEW[1,JRA] blob
sn#005892 filedate 1972-09-14 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP RESOLVE1
00400 (LAMBDA(C D)
00500 (PROG (CB DB DB1 YC YD YD1 Z X Y RES)
00600 (COND ((AND COND (EVAL COND)) (ERR (CDR LCL))))
00700 (SETQ YC (CDR C))
00800 (SETQ CB (POSBIT C))
00900 (SETQ YD1 (NEGL D))
01000 (SETQ DB1 (NEGBIT D))
01100 (SETQ DB DB1)
01200 (SETQ YD YD1)
01300 RES1 (SETQ X (CAR YC))
01400 (COND ((NEG X) (RETURN RES)))
01500 (SETQ Y (CAR YD))
01600 (COND ((ORDERP (CAR X) (CADR Y)) (GO RES3)) ((NOT (EQ (CAR X) (CADR Y))) (GO RES4)))
01700 (COND((AND(EQ(CAR X) @LE)(MEMQ @R (PRDLET(CDR D))))(GO RES3A)))
01800 (SETQ YD1 YD)
01900 (SETQ DB1 DB)
02000 (GO RES2A)
02100 RES2 (SETQ Y (CAR YD))
02200 (COND ((NOT (EQ (CAR X) (CADR Y))) (GO RES3A)))
02300 RES2A
02400 (COND ((NOT (UNIFAB (CAR CB) (CAR DB))) (GO RES2B)))
02500 (SETQ Z (UNIFY (CDR X) (CDDR Y)))
02600 (COND ((NULL Z) (GO RES2B)))
02700 (SETQ PARRES NIL)
02800 (SETQ Z (UNION (CDR Z) C D X Y))
02900 (COND ((NULL Z) (GO RES2B)) ((NULL (CAR Z)) (RETURN Z)))
03000 (SETQ RES (CONS (SET2 (CAR (COND (DLIST (DEMOD Z DLIST)) (T Z))) TBL) RES))
03100 RES2B
03200 (SETQ YD (CDR YD))
03300 (COND (YD (SETQ DB (CDR DB)) (GO RES2)))
03400 RES3A
03500 (SETQ DB DB1)
03600 (SETQ YD YD1)
03700 RES3 (SETQ YC (CDR YC))
03800 (COND (YC (SETQ CB (CDR CB)) (GO RES1)))
03900 (RETURN RES)
04000 RES4 (SETQ YD (CDR YD))
04100 (COND (YD (SETQ DB (CDR DB)) (GO RES1)))
04200 (GO RES3A)))
04300 EXPR)
04400
04500 (DEFPROP PARMOD1
04600 (LAMBDA(C D)
04700 (PROG (YC YD Z Z1 Z2 X Y Y1 Y2 PAR TS)
04800 (COND ((EQ C D) (RETURN NIL)))
04900 (SETQ YC (CDR C))
05000 PAR1 (SETQ YD (CDR D))
05100 (SETQ X (CAR YC))
05200 (COND ((NEG X) (RETURN PAR))
05300 ((ORDERP (CAR X) EQUAL) (GO PAR2))
05400 ((NOT (EQ (CAR X) EQUAL)) (RETURN PAR)))
05500 PAR3 (COND ((EQUAL (CADR X) (CADDR X)) (GO PAR2)))
05700 PAR3A
05800 (COND ((NEG (CAR YD)) (SETQ Z2 (CDAR YD))) (T (SETQ Z2 (CAR YD))))
05900 (SETQ Y1 (CDR X))
06000 (COND ((VAR (CAR Y1)) (GO PAR7A)))
06100 (SETQ Y2 (CADR Y1))
06200 (SETQ Z (TERMS (CAAR Y1) (CDR Z2) PDEPTH))
06300 (COND ((NULL Z) (GO PAR7A)))
06400 PAR5 (SETQ Z1 Z)
06500 PAR4 (SETQ Y (UNIFY (LIST (CAR Y1)) (LIST (CAAR Z1))))
06600 (COND (Y (GO PAR6)))
06700 PAR7 (SETQ Z1 (CDR Z1))
06800 (COND (Z1 (GO PAR4)))
06900 PAR7A
07000 (SETQ YD (CDR YD))
07100 (COND (YD (GO PAR3A)))
07200 PAR2 (SETQ YC (CDR YC))
07300 (COND (YC (GO PAR1)))
07400 (RETURN PAR)
07500 PAR6 (SETQ TS (CADR (SUBS3T* (CDR Y) (LIST NIL Y2))))
07600 PAR9 (SETQ PARRES (SUBS3TA (CDR Y) Z2 (CAR Z1) TS))
07700 (COND ((NEG (CAR YD)) (SETQ PARRES (CONS ESCAPE PARRES))))
07800 (SETQ Y (UNION (CDR Y) C D X (CAR YD)))
07900 (COND ((NULL Y) (GO PAR7)))
08000 (SETQ PAR (CONS (SET2 (CAR (COND (DLIST (DEMOD Y DLIST)) (T Y))) TBL) PAR))
08100 (GO PAR7)))
08200 EXPR)
08300 (DE PRDLET(C)
08400 (PROG(Z)
08500 A(COND((NEG(CAR C))(SETQ Z(CONS(CADAR C) Z)))
08600 (T(SETQ Z(CONS(CAAR C) Z))))
08700 (SETQ C(CDR C))
08800 (COND(C(GO A)))(RETURN Z)))
08900